home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / COPIA SITI / Getleft / getleft-setup-notcl.exe / {app} / scripts / Ayuda.tcl next >
Encoding:
Text File  |  2004-05-25  |  16.6 KB  |  445 lines
  1. ###############################################################################
  2. ###############################################################################
  3. ##                          Ayuda.tcl
  4. ###############################################################################
  5. ###############################################################################
  6. ## Includes the procedures needed for the commands in the 'help' menu
  7. ###############################################################################
  8. ###############################################################################
  9. ## (c) 1999-2004 AndrΘs Garcφa Garcφa. fandom@retemail.es
  10. ## You may distribute the contents of this file under the terms of the GPL v2
  11. ###############################################################################
  12. ###############################################################################
  13.  
  14. namespace eval Ayuda {
  15.  
  16. set tclLogo [image create photo -file "$dirGetleft(images)/pwrdLogo150.gif"]
  17. set about   [image create photo -file "$dirGetleft(images)/about.gif"]
  18. set curl    [image create photo -file "$dirGetleft(images)/curl.gif"]
  19.  
  20. ###############################################################################
  21. # Manual
  22. #   Shows Getleft's manual.
  23. ###############################################################################
  24. proc Manual {} {
  25.     global dirGetleft getleftState
  26.  
  27.     help::init [file join $dirGetleft(doc) help.help]  contents "" 450 600
  28.  
  29.     return
  30. }
  31.  
  32. ###############################################################################
  33. # Changes
  34. #   Shows the 'Changes' log
  35. ###############################################################################
  36. proc Changes {} {
  37.     global dirGetleft
  38.  
  39.     help::init [file join $dirGetleft(doc) help.help] changes
  40.  
  41.     return
  42. }
  43.  
  44. ###############################################################################
  45. # Licence
  46. #   Shows the GPL.
  47. ###############################################################################
  48. proc Licence {} {
  49.     global dirGetleft
  50.  
  51.     help::init [file join $dirGetleft(doc) help.help] GPL
  52.  
  53.     return
  54. }
  55.  
  56. ###############################################################################
  57. # About
  58. #    Shows some info about the program.
  59. ###############################################################################
  60. proc About {} {
  61.     global dirGetleft
  62.     global labelButtons labelTitles indexButtons
  63.  
  64.     if {[winfo exists .acercade]} {
  65.         raise .acercade .
  66.         return
  67.     }
  68.  
  69.     set coord(x) [winfo rootx .]
  70.     set coord(y) [winfo rooty .]
  71.  
  72.     set ven [toplevel .acercade]
  73.     wm title $ven $labelTitles(about)
  74.     wm resizable $ven 0 0
  75.     wm geometry  $ven +[expr {$coord(x)+180}]+[expr {$coord(y)+50}]
  76.  
  77.     set interno    [frame $ven.interno -bd 2 -relief sunken]
  78.     set internoLft [frame $interno.left]
  79.     set internoCnt [frame $interno.center]
  80.     set internoRgt [frame $interno.right]
  81.  
  82.     set tclIma  [button $internoLft.tcl   -image $Ayuda::tclLogo -relief flat \
  83.             -cursor hand2                                                     \
  84.             -command "Ayuda::InvokeBrowser http://tcl.activestate.com $ven"]
  85.     set textIma [button $internoCnt.texto -image $Ayuda::about   -relief flat \
  86.             -cursor hand2                                                     \
  87.             -command "Ayuda::InvokeBrowser http://personal1.iddeo.es/andresgarci/getleft/english/ $ven"]
  88.     set curlIma [button $internoRgt.curl  -image $Ayuda::curl    -relief flat \
  89.             -cursor hand2                                                     \
  90.             -command "Ayuda::InvokeBrowser http://curl.haxx.se $ven"]
  91.     set aceptar [underButton::UnderButton $ven.aceptar -buttontype button     \
  92.             -textvariable labelButtons(ok) -command "destroy $ven"            \
  93.             -under $indexButtons(ok)]
  94.  
  95.     pack $interno
  96.     pack $internoLft $internoCnt $internoRgt -side left
  97.     pack $tclIma
  98.     pack $textIma
  99.     pack $curlIma
  100.     pack $ven.aceptar -pady 4
  101.  
  102.     bind $ven <Escape> "$aceptar invoke"
  103.  
  104.     focus $aceptar
  105.  
  106.     return
  107. }
  108.  
  109. ###############################################################################
  110. # GuessLinuxBrowser
  111. #    If the user hasn't set a browser yet we will try to guess it by using the
  112. #    BROWSER enviromental variable, if that fails, Mozilla seems like a 
  113. #    safe bet.
  114. #
  115. # Returns:
  116. #    The browser to use.
  117. ###############################################################################
  118. proc GuessLinuxBrowser {} {
  119.     global env
  120.  
  121.     if {[info exists env(BROWSER)]} {
  122.         return $env(BROWSER)
  123.     }
  124.     return mozilla
  125. }
  126.  
  127. ###############################################################################
  128. # EnableBrowserEntry
  129. #    Enables or disables the entry to choose a browser.
  130. #
  131. # Parameter:
  132. #    entryPath: Just that.
  133. ###############################################################################
  134. proc EnableBrowserEntry {entryPath} {
  135.     variable browserTemp
  136.     global   getleftOptions
  137.  
  138.     if {$browserTemp=="other"} {
  139.         $entryPath configure -state normal                               \
  140.                 -bg $getleftOptions(bg)    -fg $getleftOptions(fg)
  141.         focus $entryPath
  142.     } else {
  143.         $entryPath configure -state disabled                             \
  144.                 -bg $getleftOptions(disBg)    
  145.     }
  146.     return
  147. }
  148.  
  149. ###############################################################################
  150. # ChooseLinuxBrowserCommon
  151. #    This procedure takes care of creating the parts of the window that are
  152. #    shared between the proper 'Choose Browser' dialog and the one in the 
  153. #    configuration wizard.
  154. #
  155. # Parameter:
  156. #    The widget in which it will be put.
  157. ###############################################################################
  158. proc ChooseLinuxBrowserCommon {parent} {
  159.     global getleftOptions getleftState labelDialogs labelFrames indexDialogs
  160.     variable window
  161.  
  162.     set extFrame   [frame $parent.extFrame]
  163.     set labelFrame [fl::FrameLabel $extFrame.labelFrame -bd 2 -relief groove   \
  164.             -textvariable labelFrames(browser)]
  165.  
  166.     set galeon    [underButton::UnderButton $labelFrame.galeon                 \
  167.             -value "galeon"   -buttontype radiobutton -under 0                 \
  168.             -text Galeon    -variable Ayuda::browserTemp                       \
  169.             -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"]
  170.     set konqueror [underButton::UnderButton [list $labelFrame.kfmclient openProfile webbrowsing] \
  171.             -value [list kfmclient openProfile webbrowsing]                    \
  172.             -buttontype radiobutton   -under 0     \
  173.             -text Konqueror -variable Ayuda::browserTemp                       \
  174.             -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"]
  175.     set mozilla   [underButton::UnderButton $labelFrame.mozilla                \
  176.             -value "mozilla"  -buttontype radiobutton -under 0                 \
  177.             -text Mozilla   -variable Ayuda::browserTemp                       \
  178.             -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"]
  179.     set netscape  [underButton::UnderButton $labelFrame.netscape               \
  180.             -value "netscape" -buttontype radiobutton -under 0                 \
  181.             -text Netscape  -variable Ayuda::browserTemp                       \
  182.             -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"]
  183.     set opera     [underButton::UnderButton $labelFrame.opera                  \
  184.             -value "opera"    -buttontype radiobutton -under 3                 \
  185.             -text Opera     -variable Ayuda::browserTemp                       \
  186.             -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"]
  187.     set phoenix   [underButton::UnderButton $labelFrame.phoenix                \
  188.             -value "phoenix"  -buttontype radiobutton -under 0                 \
  189.             -text Phoenix   -variable Ayuda::browserTemp                       \
  190.             -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"]
  191.  
  192.     set other     [underButton::UnderButton $labelFrame.other                  \
  193.             -value "other"    -buttontype radiobutton -under 1                 \
  194.             -textvariable labelDialogs(other) -variable Ayuda::browserTemp     \
  195.             -command "Ayuda::EnableBrowserEntry $labelFrame.browserEntry"]
  196.  
  197.     set browserEntry [entry $labelFrame.browserEntry -width 20                 \
  198.             -bg $getleftOptions(bg) -fg $getleftOptions(fg)]
  199.  
  200.     set window(browserEntry) $browserEntry
  201.  
  202.     if {![info exists getleftState(browser)]} {
  203.         set Ayuda::browserTemp other
  204.         set getleftState(browser) [GuessLinuxBrowser]
  205.     }
  206.  
  207.     if {[catch {$labelFrame.$getleftState(browser) invoke}]} {
  208.         set browserTemp other
  209.         $browserEntry delete 0 end
  210.         $browserEntry insert 0 $getleftState(browser)
  211.         focus $browserEntry
  212.     } else {
  213.         focus $labelFrame.$getleftState(browser)
  214.     }
  215.  
  216.     grid $extFrame     -padx  10 -ipady 5
  217.     grid $labelFrame   -ipadx 30 -ipady 7 -pady 5 -padx 3
  218.     grid $galeon       -sticky w
  219.     grid $konqueror    -sticky w
  220.     grid $mozilla      -sticky w
  221.     grid $netscape     -sticky w
  222.     grid $opera        -sticky w
  223.     grid $phoenix      -sticky w
  224.     grid $other        -sticky w
  225.     grid $browserEntry -sticky w
  226.  
  227.     return
  228. }
  229.  
  230. ###############################################################################
  231. # ChooseLinuxBrowserControl
  232. #    Gets invoked when the user accepts or cancels the dialog to choose the
  233. #    Linux Broswer.
  234. #
  235. # Parameters:
  236. #    set: '1' if the user accepted, so we set the browser.
  237. #    parent: Window over which the messages will appear
  238. #
  239. # Returns:
  240. #    '0' if all is well, '1' if it isn't.
  241. ###############################################################################
  242. proc ChooseLinuxBrowserControl {set parent} {
  243.     global   getleftState labelTitles labelMessages
  244.     variable browserTemp
  245.     variable window
  246.  
  247.     if {$set==1} {
  248.         if {$browserTemp=="other"} {
  249.             # No paths allowed.
  250.             set temp [file tail [$window(browserEntry) get]]
  251.             if {$temp==""} {
  252.                 tk_messageBox -type ok -icon error -parent $parent         \
  253.                         -title $labelTitles(error)                         \
  254.                         -message $labelMessages(fillBrowser)           
  255.                 return 1
  256.             }
  257.             set getleftState(browser) $temp
  258.         } else {
  259.             set getleftState(browser) $browserTemp
  260.         }
  261.     }
  262.  
  263.     catch {destroy .chooseBrowser}
  264.  
  265.     return 0
  266. }
  267.  
  268. ###############################################################################
  269. # ChooseLinuxBrowser
  270. #    Since I don't know how to get the favourite browser automagically, I 
  271. #    will have to ask for it.
  272. #
  273. # Parameter
  274. #    parent: Window over which the dialog will appear, it defaults to the
  275. #            main window.
  276. ###############################################################################
  277. proc ChooseLinuxBrowser {{parent .}} {
  278.     global   getleftState labelButtons labelTitles labelMessages indexButtons
  279.     variable window
  280.  
  281.     if {$getleftState(os)!="unix"} {
  282.         tk_messageBox -type ok -icon error -parent $parent                \
  283.                 -title $labelTitles(error) -message $labelMessages(noWin)
  284.         return
  285.     }
  286.  
  287.     if {[winfo exists .chooseBrowser]} { 
  288.         raise $window(toplevel)
  289.         return
  290.     }
  291.  
  292.     set coord(x) [winfo rootx $parent]
  293.     set coord(y) [winfo rooty $parent]
  294.  
  295.     set win [toplevel .chooseBrowser]
  296.     wm title $win $labelTitles(chooseBrow)
  297.     wm resizable $win 0 0
  298.     wm geometry  $win +[expr {$coord(x)+125}]+[expr {$coord(y)+75}]
  299.  
  300.     set window(toplevel) $win
  301.  
  302.     ChooseLinuxBrowserCommon $win
  303.  
  304.     set buttons [frame  $win.extFrame.buttons]
  305.     set accept  [underButton::UnderButton $buttons.accept -buttontype button  \
  306.             -under $indexButtons(ok)     -textvariable labelButtons(ok)       \
  307.             -width 8 -command "Ayuda::ChooseLinuxBrowserControl 1 $win"]
  308.     set cancel  [underButton::UnderButton $buttons.cancel -buttontype button  \
  309.             -under $indexButtons(cancel) -textvariable labelButtons(cancel)   \
  310.             -width 8 -command "Ayuda::ChooseLinuxBrowserControl 0 $win"]
  311.  
  312.     bind $window(browserEntry) <Return>   "focus $accept"
  313.     bind $window(browserEntry) <KP_Enter> "focus $accept"
  314.  
  315.     grid $buttons -sticky e
  316.     grid $accept $cancel -padx 3
  317.  
  318.     return
  319. }
  320.  
  321. ###############################################################################
  322. # ChangeHelpCursor
  323. #    For a few seconds after clicking on a http link, the cursor will change
  324. #    to the watch cursor.
  325. #
  326. # Parameter
  327. #    Parent: The window for which the cursor will be changed.
  328. ###############################################################################
  329. proc ChangeHelpCursor {parent} {
  330.     
  331.     $parent configure -cursor watch
  332.     after 5000 "catch {$parent configure -cursor arrow}"
  333.  
  334.     return
  335. }
  336. ###############################################################################
  337. # InvokeBrowserWindows
  338. #    Invokes the default internet browser in a Windows machine and opens the
  339. #    page passed as a parameter.
  340. #
  341. #    I got most of this from a Chris Nelson entry at the Tclers' wiki.
  342. #
  343. # Parameter:
  344. #    urlToOpen: The url to open after the browser start up.
  345. #    parent: The window over which, if needed, the error message will appear,
  346. #            default to the help window.
  347. ###############################################################################
  348. proc InvokeBrowserWindows {urlToOpen parent} {
  349.     global labelTitles labelMessages
  350.  
  351.     # Look for the application under HKEY_CLASSES_ROOT
  352.     set root HKEY_CLASSES_ROOT
  353.  
  354.     # Get the application key for HTML files
  355.     set appKey [registry get $root\\.html ""]
  356.  
  357.     # Get the command for opening HTML files
  358.     set appCmd [registry get  $root\\$appKey\\shell\\open\\command ""]
  359.  
  360.     # Substitute the HTML filename into the command for %1,
  361.     # IE doesn't seem to use the %1, so we simply append it.
  362.     if {![regsub {%1} $appCmd "$urlToOpen" appCmd]} {
  363.         set appCmd [concat $appCmd $urlToOpen]
  364.     }
  365.  
  366.     # Double up the backslashes for eval.
  367.     regsub -all {\\} $appCmd  {\\\\} appCmd
  368.  
  369.     # Invoke the command
  370.     ChangeHelpCursor $parent
  371.     if {[catch {eval exec $appCmd &}]} {
  372.         tk_messageBox -type ok -icon error -title $labelTitles(error)    \
  373.                 -parent $parent -message $labelMessages(cantBrowser).
  374.     }        
  375.     return
  376. }
  377.  
  378. ###############################################################################
  379. # InvokeBrowserLinux
  380. #    Invokes the internet browser given by the user and opens the
  381. #    page passed as a parameter.
  382. #
  383. # Parameter:
  384. #    urlToOpen: The url to open after the browser start up.
  385. #    parent: The window over which, if needed, the error message will appear.
  386. ###############################################################################
  387. proc InvokeBrowserLinux {urlToOpen parent} {
  388.     global getleftState labelTitles labelMessages
  389.  
  390.     ChangeHelpCursor $parent
  391.  
  392.     if {![info exists getleftState(browser)]} {
  393.         set getleftState(browser) [GuessLinuxBrowser]
  394.     }
  395.  
  396.     # I have to be this convoluted because to open Konqueror we have to
  397.     # use a command with parameters and urls might have spaces.
  398.     # It means though, that a command with a path that contains spaces
  399.     # won't work, so no paths.
  400.     if {[catch {eval "exec $getleftState(browser) [list $urlToOpen] &"}]} {
  401.         tk_messageBox -type ok -icon error -title $labelTitles(error)    \
  402.                 -parent $parent                                          \
  403.                 -message "$labelMessages(cantBrowser):\n$getleftState(browser)"                                          \
  404.     }
  405.     return
  406. }
  407.  
  408. ###############################################################################
  409. # InvokeBrowser
  410. #    Invokes the default internet browser depending on the operating system
  411. #    we are in.
  412. #
  413. # Parameters:
  414. #    urlToOpen: The url to open after the browser starts up.
  415. #    parent:    The window over which, if needed, the error messages will
  416. #               appear, defaults to the help window.
  417. ###############################################################################
  418. proc InvokeBrowser {urlToOpen {parent .tophelpwindow}} {
  419.     global getleftState labelMessages
  420.  
  421.     if {(![regexp {:/} $urlToOpen])&&(![regexp {^/} $urlToOpen])} {
  422.         set urlToOpen http://$urlToOpen
  423.     }
  424.  
  425.     switch -exact -- $getleftState(os) {
  426.         win {
  427.             InvokeBrowserWindows $urlToOpen $parent
  428.         }
  429.         unix {
  430.             InvokeBrowserLinux   $urlToOpen $parent
  431.         }
  432.         mac  {
  433.             exec open            $urlToOpen
  434.         }
  435.         default {
  436.             tk_messageBox -type ok -icon error -title $labelTitles(error)    \
  437.                     -parent $parent                                          \
  438.                     -message $labelMessages(noBrowser)
  439.         }
  440.     }
  441.     return
  442. }
  443.  
  444. }
  445.